perm filename STAFF.FAI[XX,LCS] blob sn#207671 filedate 1976-03-19 generic text, type T, neo UTF8
00100	C**** BMSTF, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200	C  ********** WHOLE & HALF RESTS, BEAMS ******
00300		SUBROUTINE BMSTF
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900		COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000		1 RJA,YY,DISX,HGT,RZ,INP(53)
01100		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01200		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01300		1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01400		1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01500		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01600	C  RDBR IS SPACER FOR DBL BAR.
01700	C  RTF COMPENSATES FOR BAD PLANNING.
01800		RST7=RSTJ2*7.
01900		RST18=RSTJ2*18.
02000	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02100	
02200		R3Q=R3
19400	STAFF:	0		;100	RA=0
19500	;  FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S), 
19600	;  P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
19700	;  P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS. 
19800	;  PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
19900		SETZ 15,	;  RA    IF(R5.EQ.0)R5=RSTFAC(J2)
19950		MOVE 2,.COMM.+6
19975		JUMPN 2,.+3
19980		MOVE 3,.COMM.+3		;  J2
19985		MOVE 2,POSI+3(3)	; TEMP. R5 IS 2
20000		SKIPN 2			;CALL NOZERO(R5)
20005		MOVE 2,[1.0]
20100		MOVEM 2,STF+3(3)	;RSTFAC(J2)=R5
20200		MOVE 4,.COMM.+5	;RX=(J2+3)*123-369.+AMOD(R4,100.)*7.*R5
20230		FMPR 4,[7.0]
20240		FMPR 4,2
20245		MOVE 5,3
20250		ADDI 5,3	; J2+3
20260		MULI 5,=123
20270		SUBI 5,=369
20280		TLC 5,232000
20290		FADR 5,5
20295		FADR 5,4	;  5 IS RX
20400		MOVEM 5,POSI+3(3)	;STFF(J2)=RX
20500		MOVE 6,[3.0]		; RTF    RX=RX+RTF*R5
20550		FMPR 6,2
20575		FADR 5,6	; 5 IS RX
20600	;  FOR RTF SEE DATA
20700		MOVE 6,5	; 6 IS RA
20800	;  FOR 2 PASS PLOTTING
20900		RJ=RHORZ(R6)
21000		IF(R6.EQ.0)RJ=596
21100		R5=R5*14.
21200		IF(R8.EQ.0)GO TO 68
21300		IF(PLT)GO TO 68
21400		RZ=RX+R8*167.
21500	C  167 IS A MAGIC NUMBER!!  PUTS LINE ON DPY.
21600		CALL LINX(R3,RZ,RJ,RZ)
21700	C  SHOWS WHERE NEXT STAFF 0 WILL BE.
21800	68	IF(J7.EQ.0)GO TO 101
21900		IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
22000	C  TO ACTIVATE DPY BUFFER
22100		RETURN
22110	101	L=IABS(J4/100)
22120		IF(L.EQ.0)L=5
22130	C  P4=0=STANDARD 5-LINE STAFF.  600=6 LINES, ETC.
22200	69	DO 6 K=1,L
22300		RZ=RJ
22400		RW=R3
22500		IF(K.EQ.2)GO TO 66
22600		IF(K.NE.4)GO TO 67
22700	66	CALL EXCH(RW,RZ)
22800	67	CALL LINX(RZ,RX,RW,RX)
22900	6	RX=RX+R5
23000		IF(RA.EQ.1000)RETURN
23100		IF(PLT.NE.-2)RETURN
23200		RX=RA-1./RHT
23400		RA=1000
23500		GO TO 69
23600		END
24200	
24300		SUBROUTINE METER
24400	      COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
24500		COMMON/POSI/STFF(-3/4),JJ2,POS
24600		EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
24700		1,(R8,RJQ(6)),(RX3,RJQ(20)),(J10,JQ(7)),(J7,JQ(5)),(R9,RJQ(7))
24800	
24900	C  PARAMS  18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
25000	
25100		CALL NOZERO(R7)
25200		JZ=J3
25300		RY=R4+8.*R7
25400	C  HEIGHT
25500		RW=R6
25600	C  BOTTOM NUM
25700	C  P5=TOP NUM
25800		R6=R7
25900		RR6=R6
26000	C  SIZE
26100	C  FOR BDR40  -- OR =1
26200		M=0
26300		R4=RY
26400	2	R7=0
26500	C  R7=0 FOR BDR FONT??
26600	CC	IF(R5.NE.99)GO TO 1
26700		IF(R5.LT.90)GO TO 3
26800	C  99 AS METER = 'C'  98=ALLA BREVE (CUT TIME)
26900		M=-1
27000		IF(R5.NE.98)GO TO 4
27100	C NEXT FOR LINE THROUGH C.
27200		RZ=R6
27300		RY=R4
27400		RA=POS
27500		R6=RX3
27600	C  TO LINE UP WITH R3
27700		J10=2
27800	C  FOR THICK LINE
27810	CC	R5=9.8+R4
27900	CC	R4=R4+4.2
28000		R4=R4-3.8
28050		R5=R4+5.6
28100		J7=0
28200		R8=0
28300		CALL ITMSUB
28400		POS=RA
28500		R4=RY
28600		R6=RZ
28700	C GET BACK THE RIGHT PARAMS.
28800	
28900	4	R5=9999.
29000		GO TO 3
29100	C  TO CENTER 12S AND 16S
29200	3	CALL MAKNUM(R5)
29300		IF(M)RETURN
29400	C  STICK AROUND FOR BOTTOM NUM
29500		M=-1
29600		R4=RY-4.*RR6
29700		R6=RR6
29800		R5=RW
29900	C  GET BOTTOM NUM
30000		J3=JZ
30100		R8=0
30200		GO TO 2
30300		END
30900	
31000		SUBROUTINE MAKNUM(RNUM)
31100		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
31200		EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
31300	     1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
31400		1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
31500		1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
31600		DATA RS/10.0/,RBX/1.0/
31700		RB8=R8
31800		J3X=J3
31900	C P7=0=BDR40; =1=BDI40; =2=PRIM.
32000		CALL NOZERO(R6)
32100		R5=R6
32200	C  UPPER CASE - BDR40
32300		R6=48000000.0+(R7+50.)*10000.
32400		R7=99999999.0
32500	C  BLANKS
32600		R8=R7
32700		IF(RNUM.NE.9999.)GO TO 2
32800	C  NEXT FOR 'C'OMMON TIME
32900		RNUM=12.
33000	C  MAKES A 'C'
33100		R4=R4-2.2
33200	C  .2 FOR BAD POS. OF LETTERS
33300		GO TO 4
33400	
33500	2	ONE=0 
33600		RNUM=IFIX(RNUM)
33700	C  SO MISTAKES (i.e. 2.2) WON'T BREAK THE PROG.
33800		IF(RNUM.EQ.1.)ONE=3.
33900		IF(RNUM.GT.9.)GO TO 3
34000	C  JUMP FOR 2 OR 3 DIGIT NUMBER
34100	4	R6=R6+RNUM*100.+47.
34200	C  PUTS BLANK ON END (.47)
34300		GO TO 1
34400	
34500	3	RJY=10.
34600		IF(RNUM.GE.100.)RJY=100.
34700		B=IFIX(RNUM/RJY)
34800		C=AMOD(RNUM,RJY)
34900		IF(RNUM.LT.100)GO TO 7
35000		D=IFIX(C/10.)
35100		C=AMOD(C,10.)
35200		IF(C.EQ.1.)ONE=ONE+3.
35300		R7=C*1000000.+999999.0
35400		C=D
35500	7	R6=R6+B*100.+C
35600		IF(B.EQ.1.)ONE=ONE+3.
35700		IF(C.EQ.1.)ONE=ONE+3.
35800		B=R5
35900		IF(RNUM.GE.100.)B=B*2
36000		J3=J3-RS*RSTJ2*B
36100	C  FOR 2 DIGIT NUMBER
36200	CCC	IF(RNUM.GE.20.)GO TO 6
36300	CCC	IF(JA.EQ.18)GO TO 6
36400	CCC	RJY=5.6
36500	CCC	IF(RNUM.GT.11.)RJY=3.
36600	C  ADJUSTS FOR 11, ETC.
36700	CCC	J2=J2+RJY*R5*RSTJ2
36800	CC6	J3=J2
36900	1	J3=J3+ONE*R5*RSTJ2
37000	C CENTERS THE NUMBER '1'
37100		CALL ALPHA
37200		J3=J3X
37300		IF(RB8.EQ.0)RETURN
37400	C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
37500		R3=J3-R5
37600		IF(J10.EQ.0)J10=1
37700	C  USE J10 FOR EVEN THICKER BOX AND CIRC.
37800		IF(RNUM.GT.9)R3=R3+R5*RBX
37900	C  TO SET CENTER
38000		IF(RB8.EQ.2)GO TO 5
38100		R4=R4+R5+.1+.05/R5
38200	C  END OF ABOVE IS FOR SMALL CIRCLES.
38300		B=4.5
38400		IF(RNUM.GE.100.)B=5.5
38500		R5=R5*B
38600		JA=12
38700		J6=0
38800		J7=0
38900		J8=J10
39000		CALL CENTX
39100		CALL SLUR
39200		RETURN
39300	
39400	5	JA=4
39500		B=6
39600		R9=0
39700		IF(RNUM.LT.100.)GO TO 8
39800		B=9.
39900		R9=R5*6.
40000	C  MAKES RECTANGLE IF ≥100
40100	8	R4=R4+R5*.7+.1
40200		R8=R5*B
40300		J5=50
40400		CALL ITMSUB
40500	C  RETURNS ORIG. HORIZ. POS.
40600		END
40700	C  MAKES ONLY 1 TO 3 DIGIT NUMS NOW.  EXPAND LATER.
40800